﻿Option Explicit On

Public Module OOo_Examples

    ' ---------- divers exemples , faire ConnectOpenOffice avant de les appeler -------------
    ' ---------- various examples , ConnectOpenOffice before calling them -------------------




    Sub HelloWorldExample()
        Dim myDoc As Object, myText As Object, myCursor As Object

        myDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, dummyArray)
        myText = myDoc.Text
        myCursor = myText.createTextCursor
        myText.insertString(myCursor, OOoMess111, False)
        ' insertion d'une marque de paragraphe, avec une constante API
        ' inserting a paragraph break, using an API constant
        myText.insertControlCharacter(myCursor, OOOtextControlCharacterPARAGRAPH_BREAK, False)
        myCursor.CharColor = OOoRGB(0, 200, 0)
        myText.insertString(myCursor, OOoMess112, False)
        myCursor.CharWeight = OOOawtFontWeightBOLD ' an API constant
        myText.insertString(myCursor, OOoMess113, False)
        myCursor.CharColor = -1
        myCursor.CharWeight = OOOawtFontWeightNORMAL ' an API constant
        myText.insertControlCharacter(myCursor, OOOtextControlCharacterPARAGRAPH_BREAK, False)
        MsgBox(OOoMess105)
        myDoc.close(True)
    End Sub


    Sub showWorkDirectory()
        ' cette routine est indépendante de tout document
        ' elle affiche l'adresse du répertoire de travail indiqué dans la configuration d'OpenOffice

        ' this routine is independent from any document
        ' it displays the work directory indicated in the configuration of OpenOffice 
        Dim sv As Object, w As String
        sv = CreateUnoService("com.sun.star.util.PathSettings")
        w = sv.Work
        MsgBox(ConvertFromURL(w))
    End Sub


    Sub defineTabulations()
        Dim myDoc As Object, myText As Object, myCursor As Object
        Dim tabStopsList As Object, Texte1 As String, Tab As String

        Tab = Chr(9)
        myDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, dummyArray)
        myText = myDoc.Text
        myCursor = myText.createTextCursor
        ' création et remplissage d'un tableau de structures Uno
        ' create and fill an array of Uno structures             
        tabStopsList = CreateUnoStruct("com.sun.star.style.TabStop", 2)
        ' mettre 3 taquets sur le paragraphe en cours
        ' put 3 tab stops on the current paragraph 
        tabStopsList(0).DecimalChar = ","
        tabStopsList(0).FillChar = " "
        tabStopsList(0).Position = 2500 ' 25 mm ( 2,5 cm )
        tabStopsList(0).Alignment = OOOstyleTabAlignLEFT
        tabStopsList(1).DecimalChar = ","
        tabStopsList(1).FillChar = " "
        tabStopsList(1).Position = 4700 ' 47 mm
        tabStopsList(1).Alignment = OOOstyleTabAlignCENTER
        tabStopsList(2).DecimalChar = ","
        tabStopsList(2).FillChar = " "
        tabStopsList(2).Position = 7010 ' 70,1 mm
        tabStopsList(2).Alignment = OOOstyleTabAlignRIGHT
        myCursor.ParaTabStops = tabStopsList
        ' utiliser ces tabulations
        ' use these tabulation stops  
        Texte1 = "Début" & Tab & "Tab0" & Tab & "Tab1" & Tab & "Tab2" & Tab
        myText.insertString(myCursor, Texte1, False)
        myText.insertControlCharacter(myCursor, OOOtextControlCharacterPARAGRAPH_BREAK, False)
        MsgBox(OOoMess105)
        myDoc.close(True)
    End Sub



    Sub CalcSortingExample(ByVal PATH As String)
        Dim myDoc As Object, firstSheet As Object, aRange As Object
        Dim fields As Object, unoWrap As Object, sortDx As Object, n As Integer

        myDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, dummyArray)
        firstSheet = myDoc.Sheets.getByIndex(0)

        firstSheet.getCellByPosition(0, 0).String = "Texts"
        firstSheet.getCellByPosition(1, 0).String = "Values"
        firstSheet.getCellByPosition(2, 0).String = "Values2"
        Randomize()
        For n = 1 To 15
            firstSheet.getCellByPosition(0, n).String = "Row" & (n + 1)
            firstSheet.getCellByPosition(1, n).Value = Rnd() * 1000.0
            firstSheet.getCellByPosition(2, n).Value = Rnd() * 1000.0
        Next
        'MsgBox(OOoMess107)
        'aRange = firstSheet.getCellRangeByName("A1:B16")
        'fields = CreateUnoStruct("com.sun.star.table.TableSortField", 0)
        'fields(0).Field = 1
        'fields(0).IsAscending = True
        'fields(0).IsCaseSensitive = True

        '' il faut préciser quel type de séquence est transmis à la propriété SortFields
        '' you must specify which type of sequence is transmitted to SortFields property
        'unoWrap = OpenOffice.Bridge_GetValueObject
        'unoWrap.set("[]com.sun.star.table.TableSortField", fields)
        '' remplissage de SortDescriptor : propriétés ayant des valeurs autres que défaut
        '' filling of SortDescriptor : properties with non-default values  
        'sortDx = CreateProperties("ContainsHeader", True, "SortFields", unoWrap)

        'aRange.sort(sortDx)
        'MsgBox(OOoMess108)

        myDoc.storeToURL("file:///" + PATH.Replace("\", "/"), dummyArray)

        myDoc.close(True)
    End Sub



    Sub setCellBorders()
        Dim myDoc As Object, allSheets As Object, mySheet As Object
        Dim myCell As Object, oneBorder As Object

        myDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, dummyArray)
        ' un nouveau document Calc a toujours 3 feuilles
        ' a new Calc document always has 3 sheets           
        allSheets = myDoc.Sheets
        mySheet = allSheets.getByIndex(2)  ' third sheet of the spreadsheet
        mySheet.Name = "test"  ' change its name
        myCell = mySheet.getCellRangeByName("C2")
        myCell.String = OOoMess111
        ' il faut créer une nouvelle structure Uno pour chaque bord,
        ' sinon les quatre bordures vont pointer sur la même structure Uno

        ' you must create a new Uno structure for each border
        ' otherwise all 4 borders will point at the same Uno structure 
        oneBorder = CreateUnoStruct("com.sun.star.table.BorderLine")
        oneBorder.Color = OOoRGB(200, 0, 0)
        oneBorder.OuterLineWidth = 30
        myCell.LeftBorder = oneBorder ' single red line
        oneBorder = CreateUnoStruct("com.sun.star.table.BorderLine")
        oneBorder.Color = OOoRGB(200, 0, 0)
        oneBorder.OuterLineWidth = 100
        myCell.RightBorder = oneBorder ' single red line
        oneBorder = CreateUnoStruct("com.sun.star.table.BorderLine")
        oneBorder.Color = OOoRGB(0, 120, 0)
        oneBorder.OuterLineWidth = 100
        oneBorder.InnerLineWidth = 60
        oneBorder.LineDistance = 30
        myCell.TopBorder = oneBorder ' double green line
        oneBorder = CreateUnoStruct("com.sun.star.table.BorderLine")
        oneBorder.Color = OOoRGB(0, 0, 120)
        oneBorder.OuterLineWidth = 100
        oneBorder.InnerLineWidth = 60
        oneBorder.LineDistance = 30
        myCell.BottomBorder = oneBorder ' double blue line
        myDoc.CurrentController.ActiveSheet = mySheet  ' show this sheet
        MsgBox(OOoMess105)
        myDoc.close(True)
    End Sub


    Sub useDataArray()
        Dim myDoc, mySheet, cellZone, v, v0, v3

        myDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, dummyArray)
        MsgBox(OOoMess109)
        mySheet = myDoc.Sheets.getByIndex(0)
        cellZone = mySheet.getCellRangebyName("B2:C5")
        v = cellZone.getDataArray() ' get main array
        v0 = v(0) ' get array of line B2:C2
        v3 = v(3) ' get array of line B5:C5
        MsgBox("C2 = " & v0(1) & vbLf & "B5 = " & v3(0))
        v0(0) = "Hello"
        v3(1) = 987.6
        v(0) = v0
        v(3) = v3
        cellZone.setDataArray(v)
        MsgBox("B2 = ""Hello""" & vbLf & "C5 = 987.6" & vbLf & OOoMess105)
        myDoc.close(True)
    End Sub


    Sub drawPolygon()
        Dim myDoc As Object, myPage As Object, myDrawing As Object, thePoints As Object
        Dim PolygonsList(0) As Object

        myDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_blank", 0, dummyArray)
        myPage = myDoc.DrawPages.getByIndex(0)
        ' invoquer un service à  partir d"un objet Uno
        ' invoke a service from a Uno object               
        myDrawing = myDoc.createInstance("com.sun.star.drawing.PolyLineShape")
        myPage.add(myDrawing)
        myDrawing.LineWidth = 100
        myDrawing.LineColor = OOoRGB(50, 200, 200)
        ' créer et remplir un tableau de structures pour l'affecter à une propriété
        ' create and fill an array of structures to assign it to a property    
        thePoints = CreateUnoStruct("com.sun.star.awt.Point", 3)
        thePoints(0).X = 4000
        thePoints(0).Y = 2000
        thePoints(1).X = 4500
        thePoints(1).Y = 5000
        thePoints(2).X = 11500
        thePoints(2).Y = 8000
        thePoints(3).X = 6000
        thePoints(3).Y = 11000
        ' dans ce dessin : un seul polygone
        ' in this drawing : only one polygon
        PolygonsList(0) = thePoints
        myDrawing.PolyPolygon = PolygonsList
        MsgBox(OOoMess105)
        myDoc.close(True)
    End Sub

    ' Ces séquences sont à usage interne, mais elles peuvent servir d'exemples
    ' These sequences are for internal use but may be useful as examples

    Sub TestSequences()
        Dim myDoc As Object, v As Object, insp As Object, info2 As Object
        Dim myTest As Integer, c As Integer, c2 As Integer
        Dim m As String, p As String, p2 As String

        Do
            m = InputBox("Choose a test number", "COM_OOo tests", "0")
            If Not IsNumeric(m) Then myTest = 0 Else myTest = CInt(m)
            Select Case myTest
                Case 1 ' get an array of String from a Uno object (more than 800 items)
                    v = OpenOffice.AvailableServiceNames
                    MsgBox("Index max = " & UBound(v) & vbLf & "v(10) = " & v(10))
                Case 2 ' Convert to and from URL
                    Do
                        m = InputBox("MS-Windows address", "COM_OOo tests", "")
                        If Len(m) = 0 Then Exit Do
                        p = ConvertToURL(m)
                        p2 = ConvertFromURL(p)
                        MsgBox(m & vbLf & p & vbLf & p2 & vbLf & vbLf & "Identity ? " & CBool(m = p2))
                    Loop
                Case 3 ' color conversions
                    Do
                        m = InputBox("Color value ", "COM_OOo tests", "0")
                        If Not IsNumeric(m) Then c = 0 Else c = CInt(m)
                        c2 = OOoRGB(Red(c), Green(c), Blue(c))
                        MsgBox("Color : " & c & vbLf & "Red = " & Red(c) _
                          & vbLf & "Green = " & Green(c) & vbLf & "Blue = " & Blue(c) _
                          & vbLf & "OOoRGB(R,G,B) : " & c2 & vbLf & vbLf & "Identity ? " & CBool(c = c2))
                    Loop Until c = 0
                Case 20 ' CreateUnoStruct, one structure
                    v = CreateUnoStruct("com.sun.star.table.BorderLine")
                    v.Color = 12345
                    MsgBox("Color : " & v.Color)
                Case 21 ' CreateUnoStruct, array of structures
                    v = CreateUnoStruct("com.sun.star.table.BorderLine", 3)
                    c = UBound(v)
                    v(0).Color = 54321
                    v(c).OuterLineWidth = 147
                    MsgBox("Index max : " & c & vbLf & "Color : " & v(0).Color _
                      & vbLf & "OuterLineWidth : " & v(c).OuterLineWidth)
                Case 30 ' MakePropertyValue
                    v = MakePropertyValue("Height", 175)
                    MsgBox("Property name : " & v.Name)
                Case 40 ' CreateProperties
                    v = CreateProperties("Width", 369, "PrintNotes", True, "Title", "Hello")
                    c = UBound(v)
                    MsgBox("Index max : " & c & vbLf & v(0).Name & " : " & v(0).Value _
                        & vbLf & v(1).Name & " : " & v(1).Value & vbLf & v(c).Name & " : " & v(c).Value)
            End Select
            If (myTest >= 100) And (myTest < 200) Then ' Writer document is needed
                myDoc = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_blank", 0, dummyArray)
                MsgBox("Document is displayed")
                Select Case myTest
                    Case 101 ' HasUnoInterfaces
                        MsgBox("All interfaces supported ? " & HasUnoInterfaces(myDoc, _
                          "com.sun.star.frame.XStorable", _
                          "com.sun.star.style.XAutoStylesSupplier", _
                          "com.sun.star.text.XTextGraphicObjectsSupplier"))
                    Case 110 ' dispatcher
                        v = CreateProperties("Text", "Hello World !")
                        execDispatch(".uno:InsertText", v)
                        execDispatch(".uno:InsertPara", dummyArray)
                    Case 111 ' Clipboard
                        MsgBox("Select something")
                        copyToClipboard()
                        MsgBox("Put cursor elsewhere")
                        pasteFromClipboard()
                    Case 120 ' runBasicMacro
                        MsgBox("Manually load the document testScript.odt with macros enabled")
                        runBasicMacro("Standard.Module1.convertDevise", "73.5, 6.55957, Euros", "testScript")
                    Case 130 ' run script residing in "OpenOffice.org Macros"
                        runScript("HelloWorld.helloworld.bsh", dummyArray, "BeanShell", "share")
                    Case 131 ' get returned value from a script
                        MsgBox("Using resident macro : Standard.Testage.MultiplyByPi")
                        Dim args(0) As Object
                        args(0) = 67
                        v = runScript("Standard.Testage.MultiplyByPi", args)
                        MsgBox("Result from macro : " & v)
                    Case 140
                        xray(myDoc)
                    Case 150 ' checks that print method is not intercepted by the VB interpreter
                        myDoc.print(dummyArray)
                    Case 151 ' check UBound for an empty array
                        v = myDoc.TextTables.ElementNames
                        MsgBox("index max : " & UBound(v))
                    Case 152 ' check that a Null object is recognized
                        v = myDoc.TextTables
                        MsgBox("TextTables object is Null ? " & isNullEmpty(v))
                        v = myDoc.XForms
                        MsgBox("XForms object is Null ? " & isNullEmpty(v))
                    Case 160 ' this may not work if OpenOffice Registry is incorrect
                        insp = OOoIntrospection.inspect(myDoc)
                        info2 = insp.getProperty("ApplyFormDesignMode", -1)
                        v = info2.Type
                        m = v.Name  ' check that v is a com.sun.star.beans.Property
                        MsgBox("info2.Type.Name = boolean ? " & CBool(m = "boolean"))
                End Select
                MsgBox("Document will close")
                myDoc.Close(True)
            End If
        Loop Until myTest = 0

    End Sub

End Module
